home *** CD-ROM | disk | FTP | other *** search
/ Aminet 25 / Aminet 25 (1998)(GTI - Schatztruhe)[!][Jun 1998].iso / Aminet / util / pack / xpk_Source.lha / xpk_Source / E / xPKE.e < prev   
Text File  |  1998-02-08  |  8KB  |  206 lines
  1. /* $VER: xPKE 1.1 (16-4-97) © Frédéric RODRIGUES - Freeware
  2.    XPK Packing in E
  3.  
  4.    xPKE is declared freeware. This is intended for a learning use to
  5.    encourage programming of XPK in E. Do whatever you want with the files
  6.    but keep all files unchanged and together if you distribute it and
  7.    mention my name on your creations if you use it. I would appreciate
  8.    little donations for my work (who knows somebody will send me something
  9.    - please, send me at least an email).
  10.  
  11. Reach me at : rodrigue@iles.siera.ups-tlse.fr (IP 130.120.84.50)
  12.  
  13.    This program is distributed in the hope that it will be useful,
  14.    but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.    GNU General Public License for more details.
  17.  
  18.  
  19.    V1.0 (18-3-97) - First
  20.                     Was not able to make ctrl-c break to function
  21.                     There's a bug on the AmigaDos functions MatchFirst()
  22.                     MatchEnd() : Fails when using wildcards without the
  23.                     TARGET option (at least with my v37). Same bug on
  24.                     original xPack.c.
  25.    V1.1 (16-4-97) - Now better than xPack.c and xpk.c because I could make
  26.                     function ctrl-c break in the hook (see end of this)
  27.                     Still the bug reported in V1.0
  28.                     Corrected little (?) bug (xPackIt has it) which not copy
  29.                     the comment,date,protection on the TARGET subdirectories
  30.                     (it took me a while to implement this without sacrifying
  31.                     the existent code)
  32.                     Modified hook
  33.                     Did a little better programing (guess what ?)
  34. */
  35.  
  36. OPT OSVERSION=36
  37.  
  38. MODULE 'xpk/xpk','xpkmaster','utility/tagitem','dos/dos','utility/hooks',
  39.        'dos/dosasl'
  40.  
  41. CONST MAXCHARFILE=256
  42. ENUM ER_OK,ER_LIB,ER_XPK,ER_DOS,ER_MEM
  43. CONST TAG_INNAMED=3,TAG_OUTNAMET=4,TAG_OUTNAMED=5,TAG_FILENAMED=11,
  44.       TAG_PACKMETHODD=13
  45. ENUM ARG_FILES,ARG_TARGET,ARG_METHOD,ARG_PASSWORD,ARG_LOSSY,ARG_QUIET,
  46.      ARG_ALL,ARG_FORCE
  47.  
  48. DEF xpkerrmsg[XPKERRMSGSIZE]:STRING,tags:PTR TO LONG,
  49.     fib:PTR TO fileinfoblock,chunkhook:hook,myargs:PTR TO LONG,rdargs,
  50.     progress:PTR TO xpkprogress,files:PTR TO LONG,anchor:PTR TO anchorpath,
  51.     outfile[MAXCHARFILE]:STRING,lock,achain:PTR TO achain,xpkfib:xpkfib,
  52.     size,curdir[MAXCHARFILE]:STRING
  53.  
  54. PROC main() HANDLE
  55.   DEF err,delete
  56.   WriteF('\e[1m$VER: xPKE 1.1 (16-4-97) © Frédéric RODRIGUES - Freeware\n'+
  57.          '\e[4mXPK Packing in E\n\n\e[22m\e[24m')
  58.   myargs:=[NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL]
  59.   IF (rdargs:=ReadArgs('FILES/M/A,TARGET/K,METHOD/K,PASSWORD/K,LOSSY/S,'+
  60.                        'QUIET/S,ALL/S,FORCE/S',
  61.                        myargs,NIL))=NIL THEN Raise(ER_DOS)
  62.   IF (xpkbase:=OpenLibrary('xpkmaster.library',2))=NIL THEN Raise(ER_LIB)
  63.   chunkhook.entry:={chunkfunc}
  64.   GetCurrentDirName(curdir,StrMax(curdir))
  65.   SetStr(curdir,StrLen(curdir))
  66.   IF curdir[StrLen(curdir)-1]<>":" THEN StrAdd(curdir,'/',ALL)
  67.   tags:=[XPK_GETERROR,xpkerrmsg,
  68.          XPK_INNAME,NIL,
  69.          XPK_OUTNAME,NIL,
  70.          XPK_PASSWORD,myargs[ARG_PASSWORD],
  71.          IF myargs[ARG_QUIET] THEN TAG_IGNORE ELSE XPK_CHUNKHOOK,chunkhook,
  72.          XPK_FILENAME,NIL,
  73.          IF myargs[ARG_METHOD] THEN XPK_PACKMETHOD ELSE TAG_DONE,myargs[ARG_METHOD],
  74.          IF myargs[ARG_LOSSY] THEN XPK_LOSSYOK ELSE TAG_IGNORE,myargs[ARG_LOSSY],
  75.          XPK_GETOUTLEN,{size},TAG_DONE]
  76.   IF myargs[ARG_PASSWORD] THEN myargs[ARG_FORCE]:=TRUE
  77.   files:=myargs[ARG_FILES]
  78.   IF (anchor:=New(SIZEOF anchorpath+MAXCHARFILE))=NIL THEN Raise(ER_MEM)
  79.   anchor.breakbits:=SIGBREAKF_CTRL_C
  80.   anchor.strlen:=MAXCHARFILE-1
  81.   WHILE files[]
  82.     err:=MatchFirst(files[]++,anchor)
  83.     WHILE err=0
  84.       fib:=anchor.info
  85.       IF fib.direntrytype>0
  86.         IF ((anchor.flags AND APF_DIDDIR)=0) AND myargs[ARG_ALL] THEN anchor.flags:=anchor.flags OR APF_DODIR
  87.         anchor.flags:=anchor.flags AND Not(APF_DIDDIR)
  88.       ELSE
  89.         achain:=anchor.last
  90.         lock:=CurrentDir(achain.lock)
  91.         tags[TAG_INNAMED]:=fib.filename
  92.         IF myargs[ARG_TARGET] THEN makeoutfile(outfile,anchor+SIZEOF anchorpath) ELSE StringF(outfile,'xPKE\z\h[8]',FindTask(NIL))
  93.         tags[TAG_OUTNAMED]:=outfile
  94.         tags[TAG_FILENAMED]:=fib.filename
  95.         delete:=TRUE
  96.         IF fib.protection AND FIBF_DELETE AND (myargs[ARG_TARGET]=FALSE)
  97.           WriteF('\e[33mSkip\e[31m: \s delete protected\n',fib.filename)
  98.           delete:=FALSE
  99.         ELSE
  100.           IF tags[TAG_PACKMETHODD]
  101.             tags[TAG_OUTNAMET]:=TAG_DONE
  102.             IF XpkExamine(xpkfib,tags)<>0 THEN Raise(ER_XPK)
  103.             tags[TAG_OUTNAMET]:=XPK_OUTNAME
  104.             IF xpkfib.type=XPKTYPE_UNPACKED OR myargs[ARG_FORCE]
  105.               size:=0
  106.               IF XpkPack(tags)<>0 THEN Raise(ER_XPK)
  107.               IF (size>fib.size) AND (myargs[ARG_FORCE]=FALSE)
  108.                 DeleteFile(tags[TAG_OUTNAMED])
  109.                 WriteF('\e[33mSkip\e[31m: \s not packable\n',fib.filename)
  110.                 IF myargs[ARG_TARGET] THEN copy(tags[TAG_INNAMED],tags[TAG_OUTNAMED])
  111.                 delete:=FALSE
  112.               ENDIF
  113.             ELSE
  114.               WriteF('\e[33mSkip\e[31m: \s already packed\n',fib.filename)
  115.               IF myargs[ARG_TARGET] THEN copy(tags[TAG_INNAMED],tags[TAG_OUTNAMED])
  116.               delete:=FALSE
  117.             ENDIF
  118.           ELSE
  119.             IF (err:=XpkUnpack(tags))<>0
  120.               IF err=XPKERR_NOTPACKED
  121.                 WriteF('\e[33mSkip\e[31m: \s not packed\n',fib.filename)
  122.                 IF myargs[ARG_TARGET] THEN copy(tags[TAG_INNAMED],tags[TAG_OUTNAMED])
  123.                 delete:=FALSE
  124.               ELSE
  125.                 Raise(ER_XPK)
  126.               ENDIF
  127.             ENDIF
  128.           ENDIF
  129.         ENDIF
  130.         SetComment(tags[TAG_OUTNAMED],fib.comment)
  131.         SetProtection(tags[TAG_OUTNAMED],fib.protection)
  132.         SetFileDate(tags[TAG_OUTNAMED],fib.datestamp)
  133.         IF (myargs[ARG_TARGET]=FALSE) AND delete
  134.           IF DeleteFile(tags[TAG_INNAMED])=FALSE THEN Raise(ER_DOS)
  135.           IF Rename(tags[TAG_OUTNAMED],tags[TAG_INNAMED])=FALSE THEN Raise(ER_DOS)
  136.         ENDIF
  137.         CurrentDir(lock)
  138.         lock:=NIL
  139.       ENDIF
  140.       err:=MatchNext(anchor)
  141.     ENDWHILE
  142.     IF err<>ERROR_NO_MORE_ENTRIES THEN Raise(ER_DOS)
  143.     MatchEnd(anchor)
  144.   ENDWHILE
  145.   anchor:=NIL
  146.   Raise(ER_OK)
  147. EXCEPT
  148.   IF xpkbase THEN CloseLibrary(xpkbase)
  149.   IF rdargs THEN FreeArgs(rdargs)
  150.   IF lock THEN CurrentDir(lock)
  151.   IF anchor THEN MatchEnd(anchor)
  152.   SELECT exception
  153.     CASE ER_DOS;PrintFault(IoErr(),'\e[32mxPKE\e[31m');RETURN RETURN_FAIL
  154.     CASE ER_LIB;WriteF('\e[32mxPKE\e[31m: cannot open xpkmaster.library');RETURN RETURN_ERROR
  155.     CASE ER_XPK;WriteF('\e[32mxPKE\e[31m: \s\n',xpkerrmsg);RETURN RETURN_FAIL
  156.     CASE ER_MEM;PrintFault(ERROR_NO_FREE_STORE,'\e[32mxPKE\e[0m');RETURN RETURN_ERROR
  157.   ENDSELECT
  158. ENDPROC
  159.  
  160. PROC makeoutfile(outfile,infile)
  161.   DEF p=-1,buf[MAXCHARFILE]:STRING,len,indir[MAXCHARFILE]:STRING,
  162.       lock,fib:fileinfoblock,i
  163.   StrCopy(outfile,myargs[ARG_TARGET],ALL)
  164.   IF outfile[StrLen(outfile)-1]<>":" THEN StrAdd(outfile,'/',ALL)
  165.   len:=StrLen(outfile)
  166.   MidStr(buf,infile,InStr(infile,':',0)+1,ALL)
  167.   StrAdd(outfile,buf,ALL)
  168.   WHILE (p:=InStr(outfile,'/',p+1))<>-1
  169.     FOR i:=0 TO StrMax(buf)-1 DO buf[i]:=0
  170.     MidStr(buf,outfile,0,p)
  171.     UnLock(CreateDir(buf))
  172.     StrCopy(indir,curdir,ALL)
  173.     StrAdd(indir,buf+len,ALL)
  174.     IF (lock:=Lock(indir,SHARED_LOCK))=0 THEN Raise(ER_DOS)
  175.     IF Examine(lock,fib)=FALSE THEN Raise(ER_DOS)
  176.     SetComment(buf,fib.comment)
  177.     SetProtection(buf,fib.protection)
  178.     SetFileDate(buf,fib.datestamp)
  179.     UnLock(lock)
  180.   ENDWHILE
  181. ENDPROC
  182.  
  183. PROC copy(src,dest) HANDLE
  184.   DEF buf[512]:STRING,fhsrc,fhdest,nbytes
  185.   IF (fhsrc:=Open(src,OLDFILE))=NIL THEN Raise(ER_DOS)
  186.   IF (fhdest:=Open(dest,NEWFILE))=NIL THEN Raise(ER_DOS)
  187.   WHILE (nbytes:=Read(fhsrc,buf,512))>0
  188.     IF Write(fhdest,buf,nbytes)<>nbytes THEN Raise(ER_DOS)
  189.   ENDWHILE
  190.   IF nbytes<0 THEN Raise(ER_DOS)
  191.   Raise(ER_OK)
  192. EXCEPT
  193.   IF fhsrc THEN Close(fhsrc)
  194.   IF fhdest THEN Close(fhdest)
  195.   IF exception=ER_DOS THEN Raise(ER_DOS)
  196. ENDPROC
  197.  
  198. PROC chunkfunc()
  199.   MOVE.L A1,progress
  200.   WriteF('\b\s - \e[1m\s\e[22m - \d/\d kb, \d% CF, \e[1m\d% done\e[22m',
  201.          progress.activity,progress.filename,progress.ccur/1024,
  202.          progress.ulen/1024,progress.cf,progress.done)
  203.   IF (progress.type=XPKPROG_END) THEN WriteF('\e[11D at \d b/s\n',progress.speed)
  204. ENDPROC CtrlC()
  205.  
  206.